COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ENTRY CCTRAP,CCOFF,GETPPN,DGETCHAN,DRELEASE,DGETBRK,DRELBRK,DATE,GETDEV,
C00006 00003	simple internal PROCEDURE GETPPN(REFERENCE STRING CMUPPN,NAME)
C00007 00004	simple internal INTEGER PROCEDURE DGETBRK
C00014 00005	string s
C00018 00006	INTERNAL SIMPLE PROCEDURE READ(REFERENCE INTEGER CHAN INTEGER MODE REFERENCE INTEGER BRCHAR,EOF
C00019 00007	INTERNAL SIMPLE PROCEDURE WRITE(REFERENCE INTEGER CHAN INTEGER MODE REFERENCE INTEGER BRCHAR,EOF
C00020 00008	SIMPLE INTERNAL PROCEDURE APPEND (INTEGER CHAN STRING FILE REFERENCE INTEGER FLAG)
C00021 00009	INTERNAL SIMPLE BOOLEAN PROCEDURE LOCKUP(BOOLEAN LOCKIT)
C00025 ENDMK
C⊗;
ENTRY CCTRAP,CCOFF,GETPPN,DGETCHAN,DRELEASE,DGETBRK,DRELBRK,DATE,GETDEV,
      NAMFIL,READ,WRITE,OUTST,LOCKUP,TTIME,DTIME,
      SW,INDEX,STSP,IPRMPT,RPRMPT,SPRMPT,BPRMPT,TPRMPT,typetext,ONAGDP,DYNFIL,cmdinit,cmdfin,
      uptoval,
      BLKSREAD,BLKSWRTN,ERTIME,TRTIME,APPEND,APPNDTO,EBLKSREAD,EBLKSWRTN,SLABEL,ADD1,SUB1,FDNINC;
BEGIN "UTILS"
DEFINE TENEX=-1;
DEFINE STANFORD="TRUE";
REQUIRE "BUFDEC" SOURCE!FILE;
IFC STANFORD THENC REQUIRE "TENEXIO.SAI" SOURCE!FILE; ENDC

EXTERNAL INTEGER CTLOSW;
INTERNAL STRING HEADLN;
INTERNAL BOOLEAN CHKROW;
own integer cmdbrk,cmdchan,cmdeof,cmdbch,eoff;

INTERNAL SIMPLE PROCEDURE CCTRAP(PROCEDURE ABRT);
RETURN;

! PROCEDURE TO TURN OFF CONTROL C INTERCEPT;
INTERNAL SIMPLE PROCEDURE CCOFF;
RETURN;

SIMPLE INTERNAL INTEGER PROCEDURE BLKSREAD;
RETURN(0);

SIMPLE INTERNAL INTEGER PROCEDURE EBLKSREAD;
RETURN(0);

SIMPLE INTERNAL INTEGER PROCEDURE BLKSWRTN;
RETURN(0);

SIMPLE INTERNAL INTEGER PROCEDURE EBLKSWRTN;
	RETURN(0);

SIMPLE INTERNAL INTEGER PROCEDURE TRTIME;
IFC STANFORD THENC 
	RETURN(CALL(0,"RUNTIM"));
ELSEC
RETURN(RUNTM(0,0));
ENDC

SIMPLE INTERNAL INTEGER PROCEDURE ERTIME;
	BEGIN
	OWN INTEGER LAST;
	INTEGER ELAPSED,TOTAL;
	ELAPSED←(TOTAL←TRTIME)-LAST;
	LAST←TOTAL;
	RETURN(ELAPSED);
	END;

REQUIRE ERTIME INITIALIZATION;
simple internal PROCEDURE GETPPN(REFERENCE STRING CMUPPN,NAME);
IFC STANFORD THENC
    CMUPPN←NAME←CVXSTR(CALL(0,"GETPPN"));
ELSEC
    BEGIN "GETPPN"
    INTEGER DIRNAM;
    GJINF(DIRNAM,0,0);
    CMUPPN←NAME←DIRST(DIRNAM);
    END "GETPPN";
ENDC

simple internal INTEGER PROCEDURE ONAGDP;
RETURN(0);

simple internal INTEGER PROCEDURE DGETCHAN;
	RETURN(GETCHAN);

simple internal PROCEDURE DRELEASE(INTEGER CHAN);
	CFILE(CHAN);
simple internal INTEGER PROCEDURE DGETBRK;
	RETURN(GETBREAK);

simple internal PROCEDURE DRELBRK(INTEGER BRTAB);
	RELBREAK(BRTAB);

simple internal SIMPLE STRING PROCEDURE DATE;
IFC NOT STANFORD THENC
RETURN(ODTIM(-1,'000401000000));
ELSEC
BEGIN "DATE"
STRING DAY,MONTH;
INTEGER DAYNUM,YEAR;
	DAY←CASE CALL(0,"DAYCNT") MOD 7 OF("WEDNESDAY","THURSDAY","FRIDAY",
	 "SATURDAY","SUNDAY","MONDAY","TUESDAY");
	MONTH←CASE (CALL(0,"DATE")DIV 31) MOD 12 OF("JANUARY","FEBUARY","MARCH",
         "APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER",
	 "DECEMBER");
	YEAR← (CALL(0,"DATE") DIV (12*31)) + 1964;
	DAYNUM ← CALL(0,"DATE") MOD 31;
	RETURN(DAY & ", " & MONTH & " " & CVS(DAYNUM) & ", " & CVS(YEAR));
END "DATE";
ENDC
	

simple internal string procedure ttime;
comment this procedure returns the time in hr:min:sec.ms ;
IFC NOT STANFORD THENC
RETURN(ODTIM(-1,'400001000000));
ELSEC
BEGIN "TTIME"
INTEGER MSTIME;
	MSTIME←CALL(0,"MSTIME");
	RETURN(CVS(MSTIME DIV (1000*60*60)) & ":" &
	 CVS((MSTIME DIV (1000*60)) MOD 60) & ":" &
	 CVS((MSTIME DIV 10000) MOD 60) & "." & CVS(MSTIME MOD 1000));
END "TTIME";
ENDC

simple internal string procedure dtime;
IFC NOT STANFORD THENC
RETURN(ODTIM(-1,-1));
ELSEC
BEGIN "DTIME"
INTEGER MSTIME;
	MSTIME←CALL(0,"MSTIME");
	RETURN(DATE & " " & CVS(MSTIME DIV (1000*60*60)) & ":" &
	 CVS((MSTIME DIV (1000*60)) MOD 60) & ":" &
	 CVS((MSTIME DIV 10000) MOD 60));
END "DTIME";
ENDC


INTERNAL SIMPLE STRING PROCEDURE GETDEV(REFERENCE STRING PICNAM; STRING DEFAULT!EXT);
    BEGIN "GETDEV"
    INTEGER BRCHAR,BRK1,BRK2;
    STRING STR,DEV,STEMP;
    brk1←dgetbrk;
    BREAKSET(BRK1,".:","I");
    brk2←dgetbrk;
    SETBREAK(BRK2,"[",NULL,"IR");
    DEV←"DSK";
    IF PICNAM THEN 
	BEGIN
	STR←SCAN(PICNAM,BRK1,BRCHAR);
	IF BRCHAR=":" THEN
	    BEGIN
	    DEV←STR;
	    STR←SCAN(PICNAM,BRK1,BRCHAR)
	    END;
	IF BRCHAR="." THEN
	    BEGIN
	    STEMP←SCAN(PICNAM,BRK2,BRCHAR);
	    PICNAM←STR&(IF STEMP THEN "."&STEMP&PICNAM ELSE PICNAM)
	    END
	ELSE PICNAM←SCAN(STR,BRK2,BRCHAR)&"."&DEFAULT!EXT&STR;
	DRELBRK(BRK1);
	DRELBRK(BRK2)
	END;
    RETURN(DEV);
    END "GETDEV";

INTERNAL SIMPLE STRING PROCEDURE NAMFIL(STRING FILNAM);
    BEGIN "NAMFIL"
    INTEGER BRCHAR,BRK1,BRK2;
    STRING STR;
    brk1←dgetbrk;
    SETBREAK(BRK1,".:[>",NULL,"IS");
    IF FILNAM THEN 
	BEGIN
	STR←SCAN(FILNAM,BRK1,BRCHAR);
	IF BRCHAR=":" THEN
	    STR←SCAN(FILNAM,BRK1,BRCHAR);
	IF BRCHAR=">" THEN
	    STR←SCAN(FILNAM,BRK1,BRCHAR)
	END
    ELSE STR←NULL;
    DRELBRK(BRK1);
    RETURN(STR);
    END "NAMFIL";

internal simple string procedure sw(reference string inp);
    begin "sw"
    string sws,rem;
    integer brk,bch;
    sws←rem←"";
    brk←dgetbrk;
    setbreak(brk,"/",NULL,"IS");
    inp←scan(rem←inp,brk,bch←0);
    while bch do
	begin
	sws←sws&lop(rem);
	scan(rem,brk,bch←0);
	end;
   Drelbrk(brk);
    return(sws);
    end;

! Index function for finding a string in a string
  returns a 0 if it is not found.  Returns the index
  of the first character.
;
internal simple integer procedure index(string fndstr,instr);
	begin "index"
	integer i,lng,lngfnd;
	lng←length(instr)-(lngfnd←length(fndstr))+1;
	for i←1 thru lng do
		if equ(fndstr,instr[i for lngfnd]) then return(i);
	return(0);
	end "index";

! Procedure to remove leading blanks and trailing zeros
  after a .
;
INTERNAL simple string procedure stsp(string s);
	begin
	integer pos,i;
	while length(s)>0 ∧ s[1 for 1]=" " do s←s[2 to ∞];
	while length(s)>0 ∧ s[∞ for 1]=" " do s←s[1 for ∞-1];
	if pos←index(".",s) then for i←length(s) step -1 until pos-1 do if s[∞ for 1]="0" then s←s[1 for ∞-1] else done;
	return(s);
	end;

INTERNAL SIMPLE STRING PROCEDURE SLABEL(INTEGER SEL);
   RETURN(
          IF SEL="D" THEN "INTENSITY"
          ELSE IF SEL="R" THEN "RED"
          ELSE IF SEL="G" THEN "GREEN"
          ELSE IF SEL="B" THEN "BLUE"
          ELSE IF SEL="H" THEN "HUE"
          ELSE IF SEL="S" THEN "SATURATION"
	  ELSE IF SEL="M" THEN "MODIFIED HUE"
          ELSE SEL);
string s;
COMMENT procedure TO PROMPT USER FOR A VALUE (INTEGEr);
internal SIMPLE INTEGER procedure  IPRMPT(string MSG; reference integer VAL);
    BEGIN
    CTLOSW←0;
    PRINT(MSG," [",stsp(cvs(val)),"]: ");
    if length(s←if cmdchan>0 then cmdfin(eoff←0) else INTTY) then
	VAL←CVD(s);
    RETURN(VAL);
    END;

COMMENT procedure TO PROMPT USER FOR A VALUE (REAL);
internal simple REAL procedure RPRMPT(string MSG; reference real VAL);
    BEGIN
    CTLOSW←0;
    PRINT(MSG," [",stsp(cvg(val)),"]: ");
    if length(s←if cmdchan>0 then cmdfin(eoff←0) else INTTY) then
	VAL←REALSCAN(S,0);
    RETURN(VAL);
    END;

comment ONE IS FOR STRING INPUT;
internal simple STRING procedure SPRMPT(string MSG; reference string STR);
    BEGIN
    CTLOSW←0;
    PRINT(MSG," [",str,"]: ");
    if length(s←if cmdchan>0 then cmdfin(eoff←0) else INTTY) then
	STR←s;
    RETURN(STR);
    END;

COMMENT procedure TO PROMPT USER FOR A VALUE (boolean);
internal simple INTEGER procedure  BPRMPT(string MSG; reference integer VAL);
    BEGIN
    CTLOSW←0;
    while true do begin
    PRINT(MSG,"(Y or N) [",(if val then "YES" else "NO"),"]: ");
    if s←((if cmdchan>0 then cmdfin(eoff←0) else INTTY) land '137) then
	begin if s="Y" then val←-1 else if s="N" then val←0 else continue; done end
	else done;
    end;
    RETURN(VAL);
    END;
COMMENT procedure TO PROMPT USER FOR A VALUE (one of three);
internal simple INTEGER procedure  TPRMPT(string MSG; reference integer VAL);
    BEGIN
    CTLOSW←0;
    while true do begin
    PRINT(MSG,"(All or Some or None) [",(if val=-1 then "All" else if val=0 then "None"
		else "Some"),"]: ");
    if s←((if cmdchan>0 then cmdfin(eoff←0) else INTTY) land '137) then
	begin if s="A" then val←-1 else if s="N" then val←0 
			else if s="S" then val←1 else continue; done end
	else done;
    end;
    RETURN(VAL);
    END;

SIMPLE internal PROCEDURE TYPETEXT(STRING FILE);
	BEGIN "TYPE TEXT FILE"
	INTEGER CHAN,eof;
IFC NOT STANFORD THENC
	CHAN←OPENFILE(FILE,"RC");
	SETINPUT(CHAN,200,0,EOF);
ELSEC
	CHAN←GETCHAN;
	OPEN(CHAN,"TTY",0,1,0,200,0,EOF);
ENDC
	do PRINT(INPUT(CHAN,0)) until eof;
	CFILE(CHAN);
	END "TYPE TEXT FILE";

INTERNAL SIMPLE PROCEDURE READ(REFERENCE INTEGER CHAN; INTEGER MODE; REFERENCE INTEGER BRCHAR,EOF;
				REFERENCE STRING FILE; STRING DEFAULT!EXT);
    BEGIN "READ"
    GETDEV(FILE,DEFAULT!EXT);
IFC NOT STANFORD THENC
    CHAN←OPENFILE(FILE,"RC");
    SETINPUT(CHAN,1200,BRCHAR,EOF);
ELSEC
    CHAN←GETCHAN;
    OPEN(CHAN,"DEV",8,4,0,1200,BRCHAR,EOF);
ENDC
    END "READ";
INTERNAL SIMPLE PROCEDURE WRITE(REFERENCE INTEGER CHAN; INTEGER MODE; REFERENCE INTEGER BRCHAR,EOF;
				REFERENCE STRING FILE; STRING DEFAULT!EXT);
    BEGIN "WRITE"
    GETDEV(FILE,DEFAULT!EXT);
    CHAN←OPENFILE(FILE,"WC");
END "WRITE";

COMMENT PROCEDURE TO DO AN OUTSTR ONLY IF YOUR JOB IS ATTACHED;
INTERNAL SIMPLE PROCEDURE OUTST(STRING STR);
PRINT(STR);
SIMPLE INTERNAL PROCEDURE APPEND (INTEGER CHAN; STRING FILE; REFERENCE INTEGER FLAG);
	! THIS PROCEDURE CAN BE USED IN PLACE OF AN ENTER OR A LOOKUP
	  FILE IS COPIED AND YOU PROCEED FROM THERE
	  IT IS SLOW SO AVOID LARGE FILES
	  ******** USE FOR ASCII I/O ONLY *********;
    BEGIN "APPEND"
    END "APPEND";

INTERNAL SIMPLE PROCEDURE APPNDTO(STRING FILNAM,TEXT);
	    BEGIN "APPNDTO"
	    END "APPNDTO";
INTERNAL SIMPLE BOOLEAN PROCEDURE LOCKUP(BOOLEAN LOCKIT);
RETURN(0);

! Procedure to return a file name that doesn't exist with the give 1 st 2 characters
  and EXT and PPN.  If it can't give you a new name it returns the file name
  "BADFIL.UCK".
;
simple internal STRING PROCEDURE DYNFIL(STRING DEVICE,NAME,EXT,PPN);
	BEGIN "DYNFIL"
	STRING FILE,FFILE,EFILE,DEV;
	INTEGER I,CHAN,FLG;
	DEV←(IF DEVICE≠NULL THEN DEVICE ELSE "DSK");
IFC NOT STANFORD THENC
	FFILE←NAME[1 FOR 2]&CVS(GJINF(0,0,0));
ELSEC
	FFILE←NAME[1 FOR 2]&CVS(CALL(0,"PJOB"));
ENDC
	EFILE←(IF EXT=NULL THEN NULL ELSE "."&EXT)&PPN;
	FOR I←1 THRU 999 DO
		BEGIN
		FILE←FFILE&CVS(I)&EFILE;
		OPEN(CHAN←DGETCHAN,DEV,'0,4,0,0,0,0);
		LOOKUP(CHAN,FILE,FLG);
		DRELEASE(CHAN);
		IF FLG THEN RETURN((if equ(dev,"DSK") then null else dev&":")&FILE);
		END;
	RETURN("BADFIL.UCK");
	END "DYNFIL";

simple internal procedure cmdinit(string file);
    begin
    read(cmdchan←-1,0,cmdbch,cmdeof,file,"CMD");
    setbreak(cmdbrk←GETBREAK,'15,'12,"INS");
    end;

simple internal string procedure cmdfin(reference integer eoff);
    begin
    string cmd;
    eoff←-1;
    if cmdchan=0 then return(NULL);
    cmd←input(cmdchan,cmdbrk);
    if cmdeof
	then begin
	    relbreak(cmdbrk);
	    CFILE(CMDCHAN);
	    cmdchan←0;
	    end
	else eoff←0;
    outst(cmd&crlf);
    return(cmd);
    end;

simple INTEGER internal procedure uptoval(reference integer i,j; integer val,buf);
    begin "uptoval"
    integer jj,iptr;
    jj←j;
    for i←i step 1 until rows(buf) do
	begin
	iptr←inptr(i,jj,buf);
	for j←jj step 1 until colms(buf) do if ildb(iptr)=val then return(-1);
	jj←1;
	end;
    RETURN(0);
    end;
! ADD1 (SUB1) increments (decrements) its argument and returns the result;
INTERNAL INTEGER SIMPLE PROCEDURE ADD1(REFERENCE INTEGER NUM);
START!CODE "ADD1" AOS 1,NUM; END "ADD1";
INTERNAL INTEGER SIMPLE PROCEDURE SUB1(REFERENCE INTEGER NUM);
START!CODE "SUB1" SOS 1,NUM; END "SUB1";

simple internal INTEGER PROCEDURE FNDINC(REFERENCE INTEGER MAXV,MINV);
    BEGIN
    INTEGER PINCR,INCR,I;
    PINCR←(MAXV-MINV)*.095;
    I←0;
    DO BEGIN
	INCR←(CASE (I MOD 3) OF (1,2,5))*10↑(I%3);
	I←I+1;
	END UNTIL INCR>PINCR;
    MINV←(MINV%INCR)*INCR;
    MAXV←(((MAXV+INCR)%INCR)*INCR);
    RETURN(INCR);
    END;
END "UTILS"